home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / geom / math.pro < prev    next >
Text File  |  1993-01-11  |  47KB  |  1,658 lines
  1. % This file is adapted from the PostScript code that gets
  2. % included by the psfix filter, provided with Mathematica.
  3. % The only differences are the addition of the first two lines
  4. % (MyDict) and of the abbreviations at the end (starting with /Ma).
  5.  
  6. /MyDict 200 dict def
  7. MyDict begin
  8.  
  9. % The externally visible functions are:
  10. %    MathPictureStart- start page.
  11. %    MathPictureEnd    - finish off page.
  12. %    MathSubStart    - start a sub-page.
  13. %    MathSubEnd    - finish off a sub-page.
  14. %    Mdot        - draw a dot.
  15. %    Mtetra        - draw a filled tetragon.
  16. %    Metetra        - draw a filled tetragon with black edges.
  17. %    Mistroke    - intermediate stroke of multi-stroke line/curve.
  18. %    Mfstroke    - final stroke of multi-stroke line/curve.
  19. %    Msboxa        - compute coordinates of text bounding box.
  20. %    Mshowa        - plot characters.
  21. %    MathScale    - compute scaling info to contain array of points.
  22.  
  23.  
  24. % The following are only for backwards compatibility with earlier versions
  25. % of Mathematica:
  26. %    Mpstart        - identical to MathPictureStart.
  27. %    Mpend        - identical to MathPictureEnd.
  28. %    Mscale        - like MathScale but without user coordinate info.
  29.  
  30. /Mpstart {        % - Mpstart -
  31.     MathPictureStart
  32. } bind def
  33.  
  34. /Mpend {        % - Mpend -
  35.     MathPictureEnd
  36. } bind def
  37.  
  38. /Mscale {        % [pnts] Mscale -
  39.     0 1 0 1        % [pnts] xbias xscale ybias yscale
  40.     5 -1 roll    % xbias xscale ybias yscale [pnts]
  41.     MathScale    % -
  42. } bind def
  43.  
  44. %start of ISOLatin1 stuff
  45.  
  46. /ISOLatin1Encoding dup where
  47. { pop pop }
  48. {
  49. [
  50. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  51. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  52. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  53. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  54. /space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright
  55. /parenleft /parenright /asterisk /plus /comma /minus /period /slash
  56. /zero /one /two /three /four /five /six /seven
  57. /eight /nine /colon /semicolon /less /equal /greater /question
  58. /at /A /B /C /D /E /F /G
  59. /H /I /J /K /L /M /N /O
  60. /P /Q /R /S /T /U /V /W
  61. /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
  62. /quoteleft /a /b /c /d /e /f /g
  63. /h /i /j /k /l /m /n /o
  64. /p /q /r /s /t /u /v /w
  65. /x /y /z /braceleft /bar /braceright /asciitilde /.notdef
  66. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  67. /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  68. /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
  69. /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
  70. /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
  71. /dieresis /copyright /ordfeminine /guillemotleft
  72. /logicalnot /hyphen /registered /macron
  73. /degree /plusminus /twosuperior /threesuperior
  74. /acute /mu /paragraph /periodcentered
  75. /cedilla /onesuperior /ordmasculine /guillemotright
  76. /onequarter /onehalf /threequarters /questiondown
  77. /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
  78. /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis
  79. /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
  80. /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls
  81. /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
  82. /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis
  83. /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
  84. /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis
  85. ] def
  86. } ifelse
  87.  
  88. /MFontDict 50 dict def
  89.  
  90. /MStrCat    % string1 string2 MStrCat string
  91. {
  92.     exch            % s2 s1
  93.     dup length         % s2 s1 len
  94.     2 index length add    % s2 s1 len
  95.     string            % s2 s1 s
  96.     dup 3 1 roll         % s2 s s1 s
  97.     copy            % s2 s s1
  98.     length            % s2 s where
  99.     exch dup        % s2 where s s
  100.     4 2 roll exch        % s s where s2
  101.     putinterval
  102. } def
  103.  
  104. /MCreateEncoding    % name encoding MCreateEncoding newname
  105. {
  106.     % get base name
  107.     1 index        % name encoding name
  108.  
  109.     % concatenate (-) and encoding to the name
  110.     255 string cvs
  111.     (-) MStrCat
  112.     1 index MStrCat
  113.     cvn exch        % basename newname encoding
  114.  
  115.     % make encoding name
  116.     
  117.     (Encoding) MStrCat
  118.     cvn dup where
  119.     {
  120.         exch get
  121.     }
  122.     {
  123.         pop
  124.         StandardEncoding
  125.     } ifelse
  126.     3 1 roll        % vector basename newname
  127.  
  128.     % make the font if we haven't before
  129.     dup MFontDict exch known not
  130.     {
  131.         1 index findfont
  132.         dup length dict
  133.         begin
  134.             {1 index /FID ne
  135.                 {def}
  136.                 {pop pop}
  137.              ifelse} forall
  138.             /Encoding 3 index
  139.             def
  140.             currentdict
  141.         end
  142.         1 index exch definefont pop
  143.  
  144.         MFontDict 1 index
  145.         null put
  146.     }
  147.     if
  148.  
  149.     exch pop            % vector newname
  150.     exch pop            % newname
  151. } def
  152.  
  153. /ISOLatin1 { (ISOLatin1) MCreateEncoding } def
  154. /ISO8859 { (ISOLatin1) MCreateEncoding } def
  155.  
  156. %end of ISOLatin1 stuff
  157.  
  158. %
  159. % Include old font names for backward compatibility
  160. %
  161. /Mcopyfont {        % procedure to copy font
  162.     dup
  163.     maxlength
  164.     dict
  165.     exch
  166.     {
  167.     1 index
  168.     /FID
  169.     eq
  170.     {
  171.     pop pop
  172.     }
  173.     {
  174.     2 index
  175.     3 1 roll
  176.     put
  177.     }
  178.     ifelse
  179.     }
  180.     forall
  181. } def
  182.  
  183. /Plain    /Courier findfont Mcopyfont definefont pop
  184. /Bold    /Courier-Bold findfont Mcopyfont definefont pop
  185. /Italic /Courier-Oblique findfont Mcopyfont definefont pop
  186.  
  187. % Set up for the start of a page.
  188. /MathPictureStart {    % - MathPictureStart -
  189.     gsave                % -
  190.     Mtransform            % possibly rotate to landscape mode
  191.     Mlmarg                % left_margin
  192.     Mbmarg                % bottom_margin
  193.     translate            % -
  194.     Mwidth                % init_width
  195.     Mlmarg Mrmarg add        % init_width lmarg+rmarg
  196.     sub                % true_width
  197.     /Mwidth exch def        %
  198.     Mheight                % init_height
  199.     Mbmarg Mtmarg add        % init_height tmarg+bmarg
  200.     sub                % true_height
  201.     /Mheight exch def
  202.     /Mtmatrix            % /Mtmatrix
  203.     matrix currentmatrix        % /Mtmatrix text_matrix
  204.     def
  205.     /Mgmatrix            % /Mgmatrix
  206.     matrix currentmatrix        % /Mgmatrix graphics_matrix
  207.     def                % -
  208. } bind def
  209.  
  210.  
  211. % Finish off a page.
  212. /MathPictureEnd {
  213.     grestore
  214. } bind def
  215.  
  216. %MFill fills the drawing area with the current color.
  217. /MFill {
  218.     0 0         moveto
  219.     Mwidth 0     lineto
  220.     Mwidth Mheight     lineto
  221.     0 Mheight     lineto
  222.     fill
  223. } bind def
  224.  
  225. % xmin xmax ymin ymax MPlotRegion alters the origin, Mwidth and Mheight 
  226. % so that the picture fills the altered region
  227. /MPlotRegion {        % xmin xmax ymin ymax MPlotRegion
  228.     3 index        % xmin xmax ymin ymax xmin
  229.     Mwidth mul    % xmin xmax ymin ymax xmin_pos
  230.     2 index        % xmin xmax ymin ymax xmin_pos ymin
  231.     Mheight mul    % xmin xmax ymin ymax xmin_pos ymin_pos
  232.     translate    % xmin xmax ymin ymax
  233.     exch sub    % xmin xmax ymax-ymin
  234.     Mheight mul    % xmin xmax new_height
  235.     /Mheight
  236.     exch def    % xmin xmax
  237.     exch sub    % xmax-xmin
  238.     Mwidth mul    % new-width
  239.     /Mwidth
  240.     exch def
  241. } bind def
  242.  
  243. % Given a rectangle, set it up as a sub-picture.
  244. /MathSubStart {        % xmin ymin xmax ymax MathSubStart <saved state(8)>
  245.     Momatrix
  246.     Mgmatrix Mtmatrix
  247.     Mwidth Mheight        % xmin ymin xmax ymax <ss(8)>
  248.     7 -2 roll        % xmin ymin <ss(8)> xmax ymax
  249.     moveto            % xmin ymin <ss(8)>
  250.     Mtmatrix setmatrix    % xmin ymin <ss(8)>
  251.     currentpoint        % xmin ymin <ss(8)> xmax(t) ymax(t)
  252.     Mgmatrix setmatrix    % xmin ymin <ss(8)> xmax(t) ymax(t)
  253.     9 -2 roll        % <ss(8)> xmax(t) ymax(t) xmin ymin
  254.     moveto            % <ss(8)> xmax(t) ymax(t)
  255.     Mtmatrix setmatrix    % <ss(8)> xmax(t) ymax(t)
  256.     currentpoint        % <ss(8)> xmax(t) ymax(t) xmin(t) ymin(t)
  257.     2 copy translate    % <ss(8)> xmax ymax xmin ymin
  258.     /Mtmatrix matrix currentmatrix def
  259.     3 -1 roll        % <ss(8)> xmax xmin ymin ymax
  260.     exch sub        % <ss(8)> xmax xmin height
  261.     /Mheight exch def    % <ss(8)> xmax xmin
  262.     sub            % <ss(8)> width
  263.     /Mwidth exch def    % <ss(8)>
  264. } bind def
  265.  
  266.  
  267. % Restore the saved state left by the matching MathSubStart.
  268. % Note, we also leave with the new Mgmatrix as the current matrix.
  269. /MathSubEnd {        % gmat tmat lm rm bm tm w h MathSubStart -
  270.     /Mheight exch def    % gmat tmat lm rm bm tm w
  271.     /Mwidth exch def    % gmat tmat lm rm bm tm
  272.     /Mtmatrix exch def    % gmat
  273.     dup setmatrix        % gmat
  274.     /Mgmatrix exch def    % -
  275.     /Momatrix exch def    % -
  276. } bind def
  277.  
  278.  
  279. % Given a point, draw a dot.
  280. /Mdot {        % x y Mdot -
  281.     moveto        % -
  282.     0 0 rlineto    % -
  283.     stroke        % -
  284. } bind def
  285.  
  286.  
  287. % Given 4 points, draw the corresponding filled tetragon.
  288. /Mtetra {    % x0 y0 x1 y1 x2 y2 x3 y3 Mtetra -
  289.     moveto        % x0 y0 x1 y1 x2 y2
  290.     lineto        % x0 y0 x1 y1
  291.     lineto        % x0 y0
  292.     lineto        % -
  293.     fill        % -
  294. } bind def
  295.  
  296.  
  297. % Given 4 points, draw the corresponding filled tetragon with black edges.
  298. % Note, this leaves the gray level at 0 (for compatibility with the old
  299. % C code.
  300. /Metetra {    % x0 y0 x1 y1 x2 y2 x3 y3 Metetra -
  301.     moveto        % x0 y0 x1 y1 x2 y2
  302.     lineto        % x0 y0 x1 y1
  303.     lineto        % x0 y0
  304.     lineto        % -
  305.     closepath    % -
  306.     gsave        % -
  307.     fill        % -
  308.     grestore    % -
  309.     0 setgray    % -
  310.     stroke        % -
  311. } bind def
  312.  
  313.  
  314. % Mistroke is called to stroke intermediate parts of a path.  It makes
  315. % sure to resynchronize the dashing pattern and to leave the current point
  316. % as the final point of the path.
  317. /Mistroke {    % - Mistroke -
  318.     flattenpath    % -
  319.     0 0 0        % length x y
  320.     {        % length x y new_x new_y (for moves)
  321.     4 2 roll    % length new_x new_y x y
  322.     pop pop        % length new_x new_y
  323.     }
  324.     {        % length x y new_x new_y (for lines)
  325.     4 -1 roll    % length y new_x new_y x
  326.     2 index        % length y new_x new_y x new_x
  327.     sub dup mul    % length y new_x new_y dx*dx
  328.     4 -1 roll    % length new_x new_y dx*dx y
  329.     2 index        % length new_x new_y dx*dx y new_y
  330.     sub dup mul    % length new_x new_y dx*dx dy*dy
  331.     add sqrt    % length new_x new_y dlen
  332.     4 -1 roll    % new_x new_y dlen length
  333.     add        % new_x new_y new_length
  334.     3 1 roll    % new_length new_x new_y
  335.     }
  336.     {        % length x y x1 y1 x2 y2 x3 y3 (for curves)
  337.     stop        % should never be called
  338.     }
  339.     {        % length x y (for closepaths)
  340.     stop        % should never be called
  341.     }
  342.     pathforall    % length x y
  343.     pop pop        % length
  344.     currentpoint    % length final_x final_y
  345.     stroke        % length final_x final_y
  346.     moveto        % length
  347.     currentdash    % length dash_array dash_offset
  348.     3 -1 roll    % dash_array dash_offset length
  349.     add        % dash_array new_offset
  350.     setdash        % -
  351. } bind def
  352.  
  353.  
  354. % Mfstroke is called to stroke the final parts of a path.  It resets
  355. % the dashing pattern to compensate for any adjustments made by Mistroke.
  356. /Mfstroke {    % - Mfstroke -
  357.     stroke        % -
  358.     currentdash    % dash_array dash_offset
  359.     pop 0        % dash_array 0
  360.     setdash        % -
  361. } bind def
  362.  
  363.  
  364.  
  365. % Mrotsboxa is the same as Msboxa except that it takes an angle 
  366. % form the stack and the box is calculated for text rendered at this  angle.  
  367. % It gsaves in case we are starting a MathSubStart
  368. % save Mrot so that Msboxa can convert bouding box back to the non-rotated
  369. % coordinate system
  370. % call Mrotcheck to alter the offsets into the rotated system
  371. % converts Mtmatrix to render in the rotated system
  372. % the calls Msboxa which does all the work
  373. % at the end  Mtmatrix is restored and Mrot is reset to 0 
  374. /Mrotsboxa {        % [str..] gx gy sx sy ang Mrotsboxa ...  Msboxa
  375.     gsave        % in case in MathSubStart
  376.     dup        % [str..] gx gy sx sy ang ang
  377.     /Mrot
  378.     exch def    % [str..] gx gy sx sy ang
  379.     Mrotcheck    % [str..] gx gy sx_new sy_new ang
  380.     Mtmatrix    % [str..] gx gy sx sy ang Mtmatrix
  381.     dup
  382.     setmatrix
  383.     7 1 roll    % Mtmatrix [str..] gx gy sx sy ang
  384.     4 index        % Mtmatrix [str..] gx gy sx sy ang gx
  385.     4 index        % Mtmatrix [str..] gx gy sx sy ang gx gy
  386.     translate    % Mtmatrix [str..] gx gy sx sy ang
  387.     rotate        % Mtmatrix [str..] gx gy sx sy
  388.     3 index        % Mtmatrix [str..] gx gy sx sy gx
  389.     -1 mul        % Mtmatrix [str..] gx gy sx sy -gx
  390.     3 index        % Mtmatrix [str..] gx gy sx sy -gx gy
  391.     -1 mul        % Mtmatrix [str..] gx gy sx sy -gx -gy
  392.     translate    % Mtmatrix [str..] gx gy sx sy
  393.     /Mtmatrix    % now change Mtmatrix to be this new currentmatrix
  394.     matrix
  395.     currentmatrix
  396.     def
  397.     grestore    % grestore to deal with MathSubStart
  398.     Msboxa        % Mtmatrix [ x y x y] [ x y x y]
  399.     3  -1 roll    % [x y x y ] [x y x y] Mtmatrix
  400.     /Mtmatrix
  401.     exch def    % restore Mtmatrix
  402.     /Mrot
  403.     0 def        % restore Mrot
  404. } bind def
  405.  
  406.  
  407. % Given an array of strings ([str...]), which represent consecutive lines
  408. % of text, a position in graphics coordinates (gx,gy) and a position in
  409. % the bounding box coordinates (sx,sy), compute the low and high coordinates
  410. % of the resulting text, in the [gx gy tx ty] form, which corresponds to
  411. % the point (gx,gy) (in graphics coordinates) plus the offset (tx,ty) (in
  412. % text coordinates).
  413. % Note, Msboxa assumes that the current matrix is the text matrix.
  414. % Mboxout is called in case we are in Mouter to make the box bigger
  415. % Mboxrot adjusts the box to account for a rotation to convert the box
  416. % into a nonrotated coordinate system
  417. %
  418. /Msboxa {    % [str...] gx gy sx sy Msboxa [gx gy tlx tly] [gx gy thx thy]
  419.     newpath            % [str...] gx gy sx sy (just in case)
  420.     5 -1 roll        % gx gy sx sy [str...]
  421.     Mvboxa            % gx gy sx sy blx bly bhx bhy [off...]
  422.     pop            % gx gy sx sy blx bly bhx bhy
  423.     Mboxout            % adjust box for Minner
  424.     6 -1 roll        % gx gy sy blx bly bhx bhy sx
  425.     5 -1 roll        % gx gy sy bly bhx bhy sx blx
  426.     4 -1 roll        % gx gy sy bly bhy sx blx bhx
  427.     Msboxa1            % gx gy sy bly bhy tlx thx
  428.     5 -3 roll        % gx gy tlx thx sy bly bhy
  429.     Msboxa1            % gx gy tlx thx tly thy
  430.     Mboxrot            % adjust box for rotation
  431.     [            % gx gy tlx thx tly thy mark
  432.     7 -2 roll        % tlx thx tly thy mark gx gy
  433.     2 copy            % tlx thx tly thy mark gx gy gx gy
  434.     [            % tlx thx tly thy mark gx gy gx gy mark
  435.     3 1 roll        % tlx thx tly thy mark gx gy mark gx gy
  436.     10 -1 roll        % thx tly thy mark gx gy mark gx gy tlx
  437.     9 -1 roll        % thx thy mark gx gy mark gx gy tlx tly
  438.     ]            % thx thy mark gx gy [gx gy tlx tly]
  439.     6 1 roll        % [gx gy tlx tly] thx thy mark gx gy
  440.     5 -2 roll        % [gx gy tlx tly] mark gx gy thx thy
  441.     ]            % [gx gy tlx tly] [gx gy thx thy]
  442. } bind def
  443.     
  444. % Msboxa1 is an internal function which, given a bounding box coordinate
  445. % (sz), and the bounding box limits (blz and bhz), computes the actual
  446. % offsets (tlz = (blz-bhz)(sz+1)/2, thz = (blz-bhz)(sz-1)/2).
  447. /Msboxa1 {    % sz blz bhz Msboxa1 tlz thz
  448.     sub        % sz blz-bhz
  449.     2 div        % sz (blz-bhz)/2
  450.     dup        % sz (blz-bhz)/2 (blz-bhz)/2
  451.     2 index        % sz (blz-bhz)/2 (blz-bhz)/2 sz
  452.     1 add        % sz (blz-bhz)/2 (blz-bhz)/2 sz+1
  453.     mul        % sz (blz-bhz)/2 tlz
  454.     3 -1 roll    % (blz-bhz)/2 tlz sz
  455.     -1 add        % (blz-bhz)/2 tlz sz-1
  456.     3 -1 roll    % tlz sz-1 (blz-bhz)/2
  457.     mul        % tlz thz
  458. } bind def
  459.  
  460.  
  461. % Given a (non-empty) array of strings ([str...]) calculate the 
  462. % bounding box.  We do this for fixedwidth fonts or nonfixedwidth fonts
  463. % depending upon the setting of Mfixwid.  Mvboxa1 actually does a lot
  464. % of the work.  For nonfixedwidth fonts the length of the bounding
  465. % box length is made to be the summation of [(str)..] Mwidthcal
  466. % ie the maximum length of the strings and xlow
  467. %
  468. /Mvboxa    { % [str...] Mvboxa xlow ylow xhigh yhigh [off...]
  469.     Mfixwid
  470.     {
  471.     Mvboxa1
  472.     }
  473.     {
  474.     dup        % [str...] [str...]
  475.     Mwidthcal    % [str...] [ w1 w2...]
  476.     0 exch        % [str...] 0 [ w1 w2...] 
  477.     {
  478.     add
  479.     }
  480.     forall        % [str...] length
  481.     exch
  482.     Mvboxa1        % length xlow ylow xhigh yhigh [off...]
  483.     4 index        % length xlow ylow xhigh yhigh [off...] xlow
  484.     7 -1 roll    % xlow ylow xhigh yhigh [off...] xlow length
  485.     add        % xlow ylow xhigh yhigh [off...] new_xhigh
  486.     4 -1 roll
  487.     pop        % xlow ylow yhigh [off...] new_xhigh
  488.     3 1 roll    % xlow ylow new_xhigh yhigh [off...]
  489.     }
  490.     ifelse
  491. } bind def
  492.  
  493.  
  494. % Given a (non-empty) array of strings ([str...]) which represent consecutive
  495. % lines of text, compute the total bounding box assuming that we start at
  496. % (0,0) and the array of y offsets to place the lines correctly.
  497. % Note, Mvboxa assumes that the current matrix is the text matrix.
  498. % Note, Mvboxa does not alter the current path.
  499. % The vertical spacing is set so that the bounding boxes of adjacent lines
  500. % are .3 times the width of an `m' apart.
  501. /Mvboxa1 {    % [str...] Mvboxa xlow ylow xhigh yhigh [off...]
  502.     gsave        % [str...]
  503.     newpath        % [str...] (clear path fragments)
  504.     [ true        % [str...] mark true
  505.     3 -1 roll    % mark true [str...]
  506.     {        % mark {true -or- off... Xl Yl Xh Yh false} str
  507.     Mbbox        % mark {true -or- off... Xl Yl Xh Yh false} xl yl xh yh
  508.     5 -1 roll    % mark { - -or- off... Xl Yl Xh Yh} xl yl xh yh first?
  509.     {        % mark xl yl xh yh
  510.     0        % mark xl yl xh yh off1
  511.     5 1 roll    % mark off1 xl yl xh yh
  512.     }        % mark off1 XL YL XH YH
  513.     {        % mark off... Xl Yl Xh Yh xl yl xh yh
  514.     7 -1 roll    % mark off... Xl Xh Yh xl yl xh yh Yl
  515.     exch sub    % mark off... Xl Xh Yh xl yl xh yh-Yl
  516.     (m) stringwidth pop    % mark off... Xl Xh Yh xl yl xh yh-Yl pntsize
  517.     .3 mul        % mark off... Xl Xh Yh xl yl xh yh-Yl fudge
  518.     sub        % mark off... Xl Xh Yh xl yl xh off
  519.     7 1 roll    % mark off... off Xl Xh Yh xl yl xh
  520.     6 -1 roll    % mark off... off Xh Yh xl yl xh Xl
  521.     4 -1 roll    % mark off... off Xh Yh yl xh Xl xl
  522.     Mmin        % mark off... off Xh Yh yl xh XL
  523.     3 -1 roll    % mark off... off Xh Yh xh XL yl
  524.     5 index        % mark off... off Xh Yh xh XL yl off
  525.     add        % mark off... off Xh Yh xh XL YL
  526.     5 -1 roll    % mark off... off Yh xh XL YL Xh
  527.     4 -1 roll    % mark off... off Yh XL YL Xh xh
  528.     Mmax        % mark off... off Yh XL YL XH
  529.     4 -1 roll    % mark off... off XL YL XH YH
  530.     }        % mark off... XL YL XH YH
  531.     ifelse        % mark off... XL YL XH YH
  532.     false        % mark off... XL YL XH YH false
  533.     }        % mark off... XL YL XH YH false
  534.     forall        % mark off... xlow ylow xhigh yhigh false
  535.     { stop } if    % mark off... xlow ylow xhigh yhigh
  536.     counttomark    % mark off... xlow ylow xhigh yhigh (#off's+4)
  537.     1 add        % mark off... xlow ylow xhigh yhigh (#off's+5)
  538.     4 roll        % xlow ylow xhigh yhigh mark off...
  539.     ]        % xlow ylow xhigh yhigh [off...]
  540.     grestore    % xlow ylow xhigh yhigh [off...]
  541. } bind def
  542.  
  543.  
  544. % Given a string, compute the bounding box assuming that we start at (0,0).
  545. % Note, the path is assumed to be empty, and we are assumed to be in text
  546. % coordinates.  Allows for long strings.
  547. /Mbbox {    % str Mbbox xlow ylow xhigh yhigh
  548.     1 dict begin
  549.     0 0 moveto        % str
  550.     /temp (T) def
  551.     {    gsave
  552.         currentpoint newpath moveto
  553.         temp 0 3 -1 roll put temp
  554.         false charpath flattenpath currentpoint
  555.         pathbbox
  556.         grestore moveto lineto moveto} forall
  557.     pathbbox
  558.     newpath
  559.     end
  560. } bind def
  561.  
  562.  
  563. % Compute the minimum of two numbers.
  564. /Mmin {        % p q Mmin min(p,q)
  565.     2 copy        % p q p q
  566.     gt        % p q p>q?
  567.     { exch } if    % min(p,q) max(p,q)
  568.     pop        % min(p,q)
  569. } bind def
  570.  
  571.  
  572. % Compute the maximum of two numbers.
  573. /Mmax {        % p q Mmax max(p,q)
  574.     2 copy        % p q p q
  575.     lt        % p q p<q?
  576.     { exch } if    % max(p,q) min(p,q)
  577.     pop        % max(p,q)
  578. } bind def
  579.  
  580. % Mrotshowa is the same as Mshowa except that it takes an angle
  581. % from the stack and the text is rendered at this angle.
  582. % It saves Mrot (not really needed but saved anyway)
  583. % calls Mrotcheck to adjust the offsets into the rotated coordinate system
  584. % converts Mtmatrix to render in the rotated system
  585. % and calls Mshowa which does all the work
  586. % at the end Mtmatrix is restored and Mrot is reset to zero.
  587. %
  588. /Mrotshowa {         %[str..] gx gy sx sy ang Mrotshowa
  589.     dup
  590.     /Mrot
  591.     exch def
  592.     Mrotcheck
  593.     Mtmatrix    %[str..] gx gy sx sy ang Mtmatrix
  594.     dup
  595.     setmatrix
  596.     7 1 roll    %Mtmatrix [str..] gx gy sx sy ang
  597.     4 index        %Mtmatrix [str..] gx gy sx sy ang gx
  598.     4 index        %Mtmatrix [str..] gx gy sx sy ang gx gy
  599.     translate
  600.     rotate        %Mtmatrix [str..] gx gy sx sy
  601.     3 index
  602.     -1 mul
  603.     3 index
  604.     -1 mul        %Mtmatrix [str..] gx gy sx sy -gx -gy
  605.     translate
  606.     /Mtmatrix
  607.     matrix
  608.     currentmatrix
  609.     def        %Mtmatrix [str..] gx gy sx sy
  610.     Mgmatrix setmatrix
  611.     Mshowa        %Mtmatrix
  612.     /Mtmatrix
  613.     exch def
  614.     /Mrot 0 def    % restore Mrot
  615. } bind def
  616.     
  617. %
  618. % Given an array of strings ([str...]), which represent consecutive lines
  619. % of text, a position in graphics coordinates (gx,gy) and a position in
  620. % the bounding box coordinates (sx,sy), display the strings.
  621. % Mboxout is called in case we are in Mouter
  622. %
  623. /Mshowa {    % [str...] gx gy sx sy Mshowa -
  624.     4 -2 roll    % [str...] sx sy gx gy
  625.     moveto        % [str...] sx sy
  626.     2 index        % [str...] sx sy [str...]
  627.     Mtmatrix setmatrix    % [str...] sx sy [str...]
  628.     Mvboxa        % [str...] sx sy tlx tly thx thy [off...]
  629.     7 1 roll    % [str...] [off...] sx sy tlx tly thx thy
  630.     Mboxout
  631.     6 -1 roll    % [str...] [off...] sy tlx tly thx thy sx
  632.     5 -1 roll    % [str...] [off...] sy tly thx thy sx tlx
  633.     4 -1 roll    % [str...] [off...] sy tly thy sx tlx thx
  634.     Mshowa1        % [str...] [off...] sy tly thy relx
  635.     4 1 roll    % [str...] [off...] relx sy tly thy
  636.     Mshowa1        % [str...] [off...] relx rely
  637.     rmoveto        % [str...] [off...]
  638.     currentpoint    % [str...] [off...] x y
  639.     Mfixwid
  640.     {
  641.     Mshowax
  642.     }
  643.     {
  644.     Mshoway
  645.     }
  646.     ifelse
  647.     pop pop pop pop
  648.     Mgmatrix setmatrix
  649. } bind def
  650.  
  651.  
  652. % This is used for fixedwidth fonts
  653. % It simply shows each string and advances the y direction by the offset
  654. %
  655. /Mshowax {    
  656.     0 1
  657.         4 index length  % [str...] [off...] x y 0 1 (#strings)
  658.         -1 add          % [str...] [off...] x y 0 1 (#strings-1)
  659.         {               % [str...] [off...] x y strnum
  660.         2 index         % [str...] [off...] x y strnum x
  661.         4 index         % [str...] [off...] x y strnum x [off...]
  662.         2 index         % [str...] [off...] x y strnum [off...] strnum
  663.         get             % [str...] [off...] x y strnum x off
  664.         3 index         % [str...] [off...] x y strnum x off y
  665.         add             % [str...] [off...] x y strnum x Y
  666.         moveto          % [str...] [off...] x y strnum
  667.         4 index         % [str...] [off...] x y strnum [str...]
  668.         exch get        % [str...] [off...] x y str
  669.     Mfixdash
  670.     {
  671.     Mfixdashp        
  672.     }
  673.     if
  674.         show            % [str...] [off...] x y
  675.         } for           % [str...] [off...] x y
  676. } bind def
  677.  
  678. % Fix if all dashes and length > 1
  679. /Mfixdashp {        % str
  680.     dup
  681.     length        % str n
  682.     1
  683.     gt        % str bool
  684.     1 index        % str bool str
  685.     true exch    % str bool true str
  686.     {
  687.     45
  688.     eq
  689.     and
  690.     } forall
  691.     and        % str bool
  692.     {
  693.     gsave
  694.     (--)        
  695.      stringwidth pop
  696.     (-)
  697.     stringwidth pop
  698.     sub
  699.     2 div        % str lenfix
  700.     0 rmoveto    % str
  701.     dup        % str str
  702.     length
  703.     1 sub        % str len-1
  704.     {
  705.     (-)
  706.     show
  707.     }
  708.     repeat
  709.     grestore
  710.     }
  711.     if        % x y str
  712. } bind def    
  713.  
  714.  
  715. % This is for non-fixedwidth fonts
  716. % It shows each character individually advancing the x position by
  717. % the maximum width of any character in that position
  718. %
  719. /Mshoway {
  720.         3 index        % [str...] [off...] x y [str...]
  721.         Mwidthcal    % [str...] [off...] x y [w1 w2 w3...]
  722.         5 1 roll    % [w1 w2 w3..] [str...] [off...] x y
  723.     0 1        % [w1 w2 w3..] [str...] [off...] x y 0 1
  724.     4 index length    % [w1 w2 w3..] [str...] [off...] x y 0 1 (#strings)
  725.     -1 add        % [w1 w2 w3..] [str...] [off...] x y 0 1 (#strings-1)
  726.     {        % [w1 w2 w3..] [str...] [off...] x y strnum
  727.     2 index        % [w1 w2 w3..] [str...] [off...] x y strnum x
  728.     4 index        % [w1 w2 w3..] [str...] [off...] x y strnum x [off...]
  729.     2 index        % [w1 w2 w3..] [str...] [off...] x y
  730.             %            strnum [off...] strnum
  731.     get        % [w1 w2 w3..] [str...] [off...] x y strnum x off
  732.     3 index        % [w1 w2 w3..] [str...] [off...] x y strnum x off y
  733.     add        % [w1 w2 w3..] [str...] [off...] x y strnum x Y
  734.     moveto        % [w1 w2 w3..] [str...] [off...] x y strnum
  735.     4 index        % [w1 w2 w3..] [str...] [off...] x y strnum [str...]
  736.     exch get    % [w1 w2 w3..] [str...] [off...] x y str
  737.     [
  738.     6 index        % [w1 w2 w3..] [str...] [off...] x y str [ [w1 w2..]
  739.     aload
  740.     length        % [w1 w2 w3..] [str...] [off...] x y str [ w1 w2.. len
  741.     2 add
  742.     -1 roll        % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str
  743.     {
  744.     pop        % [w1 w2 w3..] [str...] [off...] x y [ w1 c2.. str am
  745.     Strform        % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str 1str
  746.     stringwidth
  747.     pop
  748.     neg 
  749.     exch        % [w1 w2 w3..] [str...] [off...] x y [ w1 w2..
  750.             %                    str -cm cn
  751.     add
  752.     0 rmoveto    % [w1 w2 w3..] [str...] [off...] x y [ w1 w2.. str
  753.     }
  754.     exch
  755.     kshow        % [w1 w2 w3..] [str...] [off...] x y [
  756.     cleartomark
  757.     } for        % [w1 w2 w3..] [str...] [off...] x y
  758.     pop    
  759. } bind def
  760.  
  761. %
  762. % This is a central mechanism for dealing with non-fixedwidth fonts.
  763. % Given an array of strings Mwidthcal returns an array of the lengths
  764. % of the longest character in the corresponding positions in the arrays.
  765. % Thus the 4th element of the result is the maximum character width of
  766. % each strin at the 4th position.
  767. %
  768. /Mwidthcal {        % [(abc) (abc) ..] Mwidthcal [w1 w2 w3 ...]
  769.     [
  770.     exch        % [ [(abc) (abd) ..]
  771.     {
  772.     Mwidthcal1
  773.     }
  774.     forall
  775.     ]        % [[w w w] [w w w] ..]
  776.     [        % call this [chr ..] now
  777.     exch        % [ [chr ..]
  778.     dup        % [ [chr ..] [chr ..]
  779.     Maxlen        % [ [chr ..] maxlen 
  780.     -1 add
  781.     0 1
  782.     3 -1 roll    % [chr ..] [ [chr ..] 0 1 maxlen-1
  783.     {
  784.     [        % [chr ..] [ [chr ..] n [
  785.     exch        % [chr ..] [ [chr ..] [ n
  786.     2 index        % [chr ..] [ [chr ..] [ n [chr ..] 
  787.     {         
  788.     1 index    
  789.     Mget        % [chr ..] [ [chr ..] [ n [w1 w2 ..] n
  790.     exch        % [chr ..] [ [chr ..] [ wn n
  791.     }
  792.     forall        
  793.     pop        % [chr ..] [ [chr ..] [ w1 w2 w3 
  794.     Maxget        % [chr ..] [ [chr ..] wmax
  795.     exch        % [chr ..] [ wmax [chr ..]
  796.     }
  797.     for
  798.     pop
  799.     ]        % [ wmax1 wmax2 wmax3 ..]
  800.     Mreva
  801. } bind def
  802.  
  803. %Reverse an array
  804. /Mreva    {        %[a b c ..] Mreva [.. c b a]
  805.     [
  806.     exch        %[ [a b c ..]
  807.     aload
  808.     length        %[a b c .. len
  809.     -1 1        %[a b c .. len -1 1
  810.     {1 roll}
  811.     for
  812.     ]        %[.. c b a]
  813. } bind def
  814.  
  815. % take an array and an index and return that element if index exits
  816. % if array not long enougth return zero
  817. /Mget    {        %[a b c d..] index
  818.     1 index
  819.     length        %[a b c d..] index len
  820.     -1 add
  821.     1 index        %[a b c d..] index (len-1) index
  822.     ge
  823.     {
  824.     get        %if long enough return entry
  825.     }
  826.     {
  827.     pop pop
  828.     0        %if not long enough return zero
  829.     }
  830.     ifelse
  831. } bind def
  832.  
  833. %Take an array of arrays and return the longest length
  834. /Maxlen    {        %[ arr1 arr2 arr3 ] Maxlen maxlen
  835.     [        %[ arr1 arr2 arr3 ] [
  836.     exch        %[ [ arr1 arr2 arr3 ]
  837.     {
  838.     length
  839.     }
  840.     forall        %[ len1 len2 len3.. 
  841.     Maxget
  842. } bind def
  843.  
  844. %Take a series of numbers starting with [ and return the largest member
  845. /Maxget    {        %[n1 n2 n3 .. Maxget nmax
  846.     counttomark    %[n1 n2 n3 .. len
  847.     -1 add        %[n1 n2 n3 .. len-1
  848.     1 1        %[n1 n2 n3 .. len 1 1
  849.     3 -1 roll    %[n1 n2 n3 .. 1 1 (len-1)
  850.     {
  851.     pop
  852.     Mmax
  853.     }
  854.     for        %[ nmax
  855.     exch        % nmax [
  856.     pop        % nmax
  857. } bind def
  858.  
  859. %Take a string and return an array of the lengths of the characters
  860. /Mwidthcal1 { % str Mwidthcal1 [w1 w2 w3 ..]
  861.     [
  862.     exch        %[ (str)
  863.     {
  864.     Strform
  865.     stringwidth
  866.     pop
  867.     }
  868.     forall        %[w1 w2 w3 ..
  869.     ]        %[w1 w2 w3 ..]
  870. } bind def
  871.  
  872. %put a string onto the stack
  873. /Strform {        % num
  874.     /tem (x) def
  875.     tem 0
  876.     3 -1 roll
  877.     put
  878.     tem
  879. } bind def
  880.  
  881. %/Mwidmax {        % [str...]
  882. %    dup        % [str...] [str...]    
  883. %    [        % [str...] [str...] [
  884. %    exch        % [str...] [ [str...]
  885. %    {
  886. %    stringwidth
  887. %    pop
  888. %    }
  889. %    forall        % [str...] [ w1 w2 ... wm wn
  890. %    0
  891. %    counttomark    % [str...] [ w1 w2 ... wm wn 0 n
  892. %    -2 add        % [str...] [ w1 w2 ... wm wn 0 (n-1)
  893. %    1 exch        % [str...] [ w1 w2 ... wm wn 0 1 (n-1)
  894. %    1 exch        % [str...] [ w1 w2 ... wm wn 0 1 1 (n-1)
  895. %    {
  896. %    3 index        % [str...] [ w1 w2 ... wm wn num pos wm
  897. %    3 index        % [str...] [ w1 w2 ... wm wn num pos wm wn
  898. %    ge
  899. %    {        % wm >= wn
  900. %    exch pop
  901. %    exch pop    % [str...] [ w1 w2 ... wm num
  902. %    }
  903. %    {        % wm < wn
  904. %    pop
  905. %    3 -1 roll    
  906. %    pop        % [str...] [ w1 w2 ... wn pos   < pos -> num >
  907. %    }
  908. %    ifelse        % [str...] [ w1 w2 ... wmax nmax
  909. %    }
  910. %    for        % [str...] [ wmax nmax
  911. %    4 1 roll
  912. %    pop pop        % nmax [str...]
  913. %    length        % nmax len
  914. %    -1 add        % nmax (len - 1)
  915. %    exch
  916. %    sub        % max_pos
  917. %} bind def
  918.  
  919.  
  920. % Mshowa1 is an internal routine which, given a bounding box coordinate
  921. % (sz), and the bounding box limits if we started drawing at 0 (tlz and thz),
  922. % computes the offset at which to start drawing
  923. % (relz = (sz-1)tlz/2 - (sz+1)thz/2 = sz(tlz-thz)/2-(tlz+thz)/2).
  924. /Mshowa1 {    % sz tlz thz Mshowa1 relz
  925.     2 copy        % sz tlz thz tlz thz
  926.     add        % sz tlz thz tlz+thz
  927.     4 1 roll    % tlz+thz sz tlz thz
  928.     sub        % tlz+thz sz tlz-thz
  929.     mul        % tlz+thz sz(tlz-thz)
  930.     sub        % tlz+thz-sz(tlz-thz)
  931.     -2 div        % sz(tlz-thz)/2-(tlz+thz)/2
  932. } bind def
  933.  
  934.  
  935. % Given the x and y scaling to user coordinates and an array of points to
  936. % fit (xbias xscale ybias yscale [pnts]), set up the scaling.  The array
  937. % must contain atleast two points, and the last two must be of the form
  938. % [gxlow gylow 0 0] and [gxhigh gyhigh 0 0].
  939. % Note, MathScale assumes that we are already scaled so that the active area
  940. % is the rectangle [0,Mwidth-Mlmarg-Mrmarg]x[0,Mheight-Mbmarg-Mtmarg].
  941. % also keep bias and scale info for PostScript commands
  942. /MathScale {        % <user> [pnts] MathScale -
  943.     Mwidth            % <user> [pnts] width
  944.     Mheight            % <user> [pnts] width height
  945.     Mlp            % <user> Ax Ay Bx By
  946.     translate        % <user> Ax Ay
  947.     scale            % <user>
  948.     /yscale exch def
  949.     /ybias exch def
  950.     /xscale exch def
  951.     /xbias exch def
  952.     /Momatrix            % this transforms from
  953.     xscale yscale matrix scale    % Original to Display coordinates
  954.     xbias ybias matrix translate
  955.     matrix concatmatrix def
  956.     /Mgmatrix        % /Mgmatrix
  957.     matrix currentmatrix    % /Mgmatrix graphics_matrix
  958.     def            % -
  959. } bind def
  960.  
  961.  
  962. % Given a non-empty array of points to fit ([p]) and a maximum width (sx)
  963. % and height (sy) find the largest scale (Ax and Ay) and offsets (Bx and By)
  964. % such that the transformation
  965. %    [gx gy tx ty] -> (Ax gx + tx + bx, Ay gy + ty + By)
  966. % maps the points into the rectangle [0,sx]x[0,sy]
  967. /Mlp {        % [p] sx sy Mlp Ax Ay Bx By
  968.     3 copy        % [p] sx sy [p] sx sy
  969.     Mlpfirst    % [p] sx sy Ax Ay
  970.     {        % [p] sx sy Ax Ay
  971.     Mnodistort    % [p] sx sy Ax Ay nodistort?
  972.     {        % [p] sx sy Ax Ay
  973.     Mmin        % [p] sx sy A
  974.     dup        % [p] sx sy Ax Ay
  975.     } if        % [p] sx sy Ax Ay
  976.     4 index        % [p] sx sy Ax Ay [p]
  977.     2 index        % [p] sx sy Ax Ay [p] Ax
  978.     2 index        % [p] sx sy Ax Ay [p] Ax Ay
  979.     Mlprun        % [p] sx sy Ax Ay ctx wtx cgx wgx cty wty cgy wgy
  980.     11 index    % [p] sx sy Ax Ay ctx wtx cgx wgx cty wty cgy wgy sx
  981.     11 -1 roll    % [p] sx sy Ay ctx wtx cgx wgx cty wty cgy wgy sx Ax
  982.     10 -4 roll    % [p] sx sy Ay cty wty cgy wgy sx Ax ctx wtx cgx wgx
  983.     Mlp1        % [p] sx sy Ay cty wty cgy wgy Ax Bx xok?
  984.     8 index        % [p] sx sy Ay cty wty cgy wgy Ax Bx xok? sy
  985.     9 -5 roll    % [p] sx sy Ax Bx xok? sy Ay cty wty cgy wgy
  986.     Mlp1        % [p] sx sy Ax Bx xok? Ay By yok?
  987.     4 -1 roll    % [p] sx sy Ax Bx Ay By yok? xok?
  988.     and        % [p] sx sy Ax Bx Ay By ok?
  989.     { exit } if    % [p] sx sy Ax Bx Ay By
  990.     3 -1 roll    % [p] sx sy Ax Ay Bx By
  991.     pop pop        % [p] sx sy Ax Ay
  992.     } loop        % [p] sx sy Ax Bx Ay By
  993.     exch        % [p] sx sy Ax Bx By Ay
  994.     3 1 roll    % [p] sx sy Ax Ay Bx By
  995.     7 -3 roll    % Ax Ay Bx By [p] sx sy
  996.     pop pop pop    % Ax Ay Bx By
  997. } bind def
  998.  
  999.  
  1000. % Given an array of points in the [gx gy tx ty] form, with the last two
  1001. % being [gxlow gylow 0 0] and [gxhigh gyhigh 0 0], and the width and height
  1002. % (sx and sy) in which to fit them, compute the maximum scaling (Ax and Ay).
  1003. /Mlpfirst {    % [pnts] sx sy Mlpfirst Ax Ay
  1004.     3 -1 roll    % sx sy [pnts]
  1005.     dup length    % sx sy [pnts] #pnts
  1006.     2 copy        % sx sy [pnts] #pnts [pnts] #pnts
  1007.     -2 add        % sx sy [pnts] #pnts [pnts] #pnts-2
  1008.     get        % sx sy [pnts] #pnts [gxl gyl 0 0]
  1009.     aload        % sx sy [pnts] #pnts gxl gyl 0 0 [gxl gyl 0 0]
  1010.     pop pop pop    % sx sy [pnts] #pnts gxl gyl
  1011.     4 -2 roll    % sx sy gxl gyl [pnts] #pnts
  1012.     -1 add        % sx sy gxl gyl [pnts] #pnts-1
  1013.     get        % sx sy gxl gyl [gxh gyh 0 0]
  1014.     aload        % sx sy gxl gyl gxh gyh 0 0 [gxh gyh 0 0]
  1015.     pop pop pop    % sx sy gxl gyl gxh gyh
  1016.     6 -1 roll    % sy gxl gyl gxh gyh sx
  1017.     3 -1 roll    % sy gxl gyl gyh sx gxh
  1018.     5 -1 roll    % sy gyl gyh sx gxh gxl
  1019.     sub        % sy gyl gyh sx delx
  1020.     div        % sy gyl gyh Ax
  1021.     4 1 roll    % Ax sy gyl gyh
  1022.     exch sub    % Ax sy dely
  1023.     div        % Ax Ay
  1024. } bind def
  1025.  
  1026.  
  1027. % Given a non-empty array of points to fit ([pnts]) and scale factors
  1028. % for graphics->text (Ax and Ay), compute the limiting points.
  1029. /Mlprun {    % [pnts] Ax Ay Mlprun ctx wtx cgx wgx cty wty cgy wgy
  1030.     2 copy        % [pnts] Ax Ay Ax Ay
  1031.     4 index        % [pnts] Ax Ay Ax Ay [pnts]
  1032.     0 get        % [pnts] Ax Ay Ax Ay [first]
  1033.     dup        % [pnts] Ax Ay Ax Ay [first] [first]
  1034.     4 1 roll    % [pnts] Ax Ay [first] Ax Ay [first]
  1035.     Mlprun1        % [pnts] Ax Ay [first] fx fy
  1036.     3 copy        % [pnts] Ax Ay [low] lx ly [high] hx hy
  1037.     8 -2 roll    % [pnts] [low] lx ly [high] hx hy Ax Ay
  1038.     9 -1 roll    % [low] lx ly [high] hx hy Ax Ay [pnts]
  1039.     {        % [low] lx ly [high] hx hy Ax Ay [pnt]
  1040.     3 copy        % [low] lx ly [high] hx hy Ax Ay [pnt] Ax Ay [pnt]
  1041.     Mlprun1        % [low] lx ly [high] hx hy Ax Ay [pnt] px py
  1042.     3 copy        % [low] lx ly [high] hx hy Ax Ay [pnt] px py [pnt] px py
  1043.     11 -3 roll    % [low] lx ly Ax Ay [pnt] px py [pnt] px py [high] hx hy
  1044.     /gt Mlpminmax    % [low] lx ly Ax Ay [pnt] px py [high] hx hy
  1045.     8 3 roll    % [low] lx ly [high] hx hy Ax Ay [pnt] px py
  1046.     11 -3 roll    % [high] hx hy Ax Ay [pnt] px py [low] lx ly
  1047.     /lt Mlpminmax    % [high] hx hy Ax Ay [low] lx ly
  1048.     8 3 roll    % [low] lx ly [high] hx hy Ax Ay
  1049.     } forall    % [low] lx ly [high] hx hy Ax Ay
  1050.     pop pop pop pop    % [low] lx ly [high]
  1051.     3 1 roll    % [low] [high] lx ly
  1052.     pop pop        % [low] [high]
  1053.     aload pop    % [low] hgx hgy htx hty
  1054.     5 -1 roll    % hgx hgy htx hty [low]
  1055.     aload pop    % hgx hgy htx hty lgx lgy ltx lty
  1056.     exch        % hgx hgy htx hty lgx lgy lty ltx
  1057.     6 -1 roll    % hgx hgy hty lgx lgy lty ltx htx
  1058.     Mlprun2        % hgx hgy hty lgx lgy lty ctx wtx
  1059.     8 2 roll    % ctx wtx hgx hgy hty lgx lgy lty
  1060.     4 -1 roll    % ctx wtx hgx hgy lgx lgy lty hty
  1061.     Mlprun2        % ctx wtx hgx hgy lgx lgy cty wty
  1062.     6 2 roll    % ctx wtx cty wty hgx hgy lgx lgy
  1063.     3 -1 roll    % ctx wtx cty wty hgx lgx lgy hgy
  1064.     Mlprun2        % ctx wtx cty wty hgx lgx cgy wgy
  1065.     4 2 roll    % ctx wtx cty wty cgy wgy hgx lgx
  1066.     exch        % ctx wtx cty wty cgy wgy lgx hgx
  1067.     Mlprun2        % ctx wtx cty wty cgy wgy cgx wgx
  1068.     6 2 roll    % ctx wtx cgx wgx cty wty cgy wgy
  1069. } bind def
  1070.  
  1071.  
  1072. % Given scale factors for graphics->text (Ax and Ay) and a point in the
  1073. % [gx gy tx ty] form, return the text x and y coordinate that results.
  1074. /Mlprun1 {    % Ax Ay [gx gy tx ty] Mlprun1 rx ry
  1075.     aload pop    % Ax Ay gx gy tx ty
  1076.     exch        % Ax Ay gx gy ty tx
  1077.     6 -1 roll    % Ay gx gy ty tx Ax
  1078.     5 -1 roll    % Ay gy ty tx Ax gx
  1079.     mul add        % Ay gy ty rx
  1080.     4 -2 roll    % ty rx Ay gy
  1081.     mul        % ty rx Ay*gy
  1082.     3 -1 roll    % rx Ay*gy ty
  1083.     add        % rx ry
  1084. } bind def
  1085.  
  1086.  
  1087. % Given a low and high coordinate, compute the center and width.
  1088. /Mlprun2 {    % low high Mlprun2 center width
  1089.     2 copy        % low high low high
  1090.     add 2 div    % low high (low+high)/2
  1091.     3 1 roll    % (low+high)/2 low high
  1092.     exch sub    % (low+high)/2 high-low
  1093. } bind def
  1094.  
  1095.  
  1096. % Given two points stored as [gx gy tx ty] followed by the scaled
  1097. % result (rx, ry), and a comparison function (lt or gt) leave the
  1098. % point which is the minimum (or maximum) in each dimension.
  1099. /Mlpminmax {    % [pnt1] r1x r1y [pnt2] r2x r2y cmp Mlpminmax [pnt] x y
  1100.     cvx        % [pnt1] r1x r1y [pnt2] r2x r2y cmp
  1101.     2 index        % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x
  1102.     6 index        % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x r1x
  1103.     2 index        % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2x r1x cmp
  1104.     exec        % [pnt1] r1x r1y [pnt2] r2x r2y cmp take2?
  1105.     {        % [pnt1] r1x r1y [pnt2] r2x r2y cmp
  1106.     7 -3 roll    % [pnt2] r2x r2y cmp [pnt1] r1x r1y
  1107.     4 -1 roll    % [pnt2] r2x r2y [pnt1] r1x r1y cmp
  1108.     } if        % [pnt1] r1x r1y [pnt2] r2x r2y cmp
  1109.     1 index        % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2y
  1110.     5 index        % [pnt1] r1x r1y [pnt2] r2x r2y cmp r2y r1y
  1111.     3 -1 roll    % [pnt1] r1x r1y [pnt2] r2x r2y r2y r1y cmp
  1112.     exec        % [pnt1] r1x r1y [pnt2] r2x r2y take2y?
  1113.     {        % [gx ? tx ?] rx ? [? gy ? ty] ? ry
  1114.     4 1 roll    % [gx ? tx ?] rx ry ? [? gy ? ty] ?
  1115.     pop        % [gx ? tx ?] rx ry ? [? gy ? ty]
  1116.     5 -1 roll    % rx ry ? [? gy ? ty] [gx ? tx ?]
  1117.     aload        % rx ry ? [? gy ? ty] gx ? tx ? [gx ? tx ?]
  1118.     pop pop        % rx ry ? [? gy ? ty] gx ? tx
  1119.     4 -1 roll    % rx ry ? gx ? tx [? gy ? ty]
  1120.     aload pop    % rx ry ? gx ? tx ? gy ? ty
  1121.     [        % rx ry ? gx ? tx ? gy ? ty mark
  1122.     8 -2 roll    % rx ry ? tx ? gy ? ty mark gx ?
  1123.     pop        % rx ry ? tx ? gy ? ty mark gx
  1124.     5 -2 roll    % rx ry ? tx ? ty mark gx gy ?
  1125.     pop        % rx ry ? tx ? ty mark gx gy
  1126.     6 -2 roll    % rx ry ? ty mark gx gy tx ?
  1127.     pop        % rx ry ? ty mark gx gy tx
  1128.     5 -1 roll    % rx ry ? mark gx gy tx ty
  1129.     ]        % rx ry ? [pnt]
  1130.     4 1 roll    % [pnt] rx ry ?
  1131.     pop        % [pnt] rx ry
  1132.     }
  1133.     {        % [gx gy tx ty] rx ry ? ? ?
  1134.     pop pop pop    % [pnt] rx ry
  1135.     } ifelse    % [pnt] rx ry
  1136. } bind def
  1137.  
  1138.  
  1139. % Given a size (s), graphics->text scale (A), text center (ct), text
  1140. % width (wt), graphics center (cg) and graphics width (wg), compute
  1141. % a new graphics->text scale (Anew) and offset (B) and whether or not
  1142. % we are done.
  1143. % Note, the mysterious .99999 is magic juju which is supposed to ward
  1144. % off the possibility that floating point errors would cause this
  1145. % routine to return the old A and yet claim not-done.
  1146. /Mlp1 {        % s A ct wt cg wg Mlp1 Anew B done?
  1147.     5 index        % s A ct wt cg wg s
  1148.     3 index    sub    % s A ct wt cg wg s-wt
  1149.     5 index        % s A ct wg cg wg s-wt A
  1150.     2 index mul    % s A ct wg cg wg s-wt A*wg
  1151.     1 index        % s A ct wg cg wg s-wt A*wg s-wt
  1152.     le        % s A ct wg cg wg s-wt fits?
  1153.     1 index        % s A ct wg cg wg s-wt fits? s-wt
  1154.     0 le        % s A ct wg cg wg s-wt fits? impossible?
  1155.     or        % s A ct wg cg wg s-wt done?
  1156.     dup        % s A ct wg cg wg s-wt done? done?
  1157.     not        % s A ct wg cg wg s-wt done? notdone?
  1158.     {        % s A ct wg cg wg s-wt done? (not done case)
  1159.     1 index        % s A ct wg cg wg s-wt done? s-wt
  1160.     3 index    div    % s A ct wg cg wg s-wt done? (s-wt)/wg
  1161.     .99999 mul    % s A ct wg cg wg s-wt done? Anew
  1162.     8 -1 roll    % s ct wg cg wg s-wt done? Anew A
  1163.     pop        % s ct wg cg wg s-wt done? Anew
  1164.     7 1 roll    % s Anew ct wg cg wg s-wt done?
  1165.     }
  1166.     if        % s Anew ct wg cg wg s-wt done?
  1167.     8 -1 roll    % Anew ct wg cg wg s-wt done? s
  1168.     2 div        % Anew ct wg cg wg s-wt done? s/2
  1169.     7 -2 roll    % Anew cg wg s-wt done? s/2 ct wg
  1170.     pop sub        % Anew cg wg s-wt done? s/2-ct
  1171.     5 index        % Anew cg wg s-wt done? s/2-ct Anew
  1172.     6 -3 roll    % Anew done? s/2-ct Anew cg wg s-wt
  1173.     pop pop        % Anew done? s/2-ct Anew cg
  1174.     mul sub        % Anew done? s/2-ct-Anew*cg
  1175.     exch        % Anew B done?
  1176. } bind def
  1177.  
  1178.  
  1179. % The following are the workings of the tick, axes and plot labels.
  1180. % NOTE a possible source of confusion is that for xticks ie tickmarks on
  1181. % the x axis we keep y information and vice versa for yticks
  1182. %
  1183. %    When Minner is found then
  1184. %
  1185. % assumes that box starts at zero on the left lower side
  1186. %
  1187. %        0)    if outflag = 1 then intop = 0, inrht = 0 outflag = 0
  1188. %        1)    Save intop     largest top of box 
  1189. %        2)    Save inrht     largest rht of box
  1190. %        3)    set inflag    notifies that inner marks are present
  1191. %
  1192. %    When Mouter is found then
  1193. %
  1194. %    if inflag is set then
  1195. %        1)    get vecx and vecy off the stack (points in direcn to move)
  1196. %        2)    vecx < 1 xadrht = inrht*abs(vecx)
  1197. %        3)    vecx > 1 xadlft = inrht*abs(vecx)
  1198. %        4)    vecy < 1 yadtop = intop*abs(vecy)
  1199. %        5)    vecy > 1 yadbot = intop*abs(vecy)
  1200. %        6)    set outflag = 1
  1201. %        7)    clear inflag, inrht, intop
  1202. %    guaranteed to be zero if no inner is present??
  1203. %
  1204. %
  1205. %    These all have effects in Mrotsboxa and Mrotshowa
  1206. %        check inflag and if set
  1207. %
  1208. %        1) increase top of bbox by yadtop
  1209. %        2) decrease bot of bbox by yadbot
  1210. %        3) increase rht of bbox by xadrht
  1211. %        4) increase lft of bbox by xadlft
  1212. %        5) clear outflag, yadtop, yadbot,
  1213. %                     xadrht, xadlft
  1214. %
  1215. %/ 
  1216.  
  1217. /intop 0 def
  1218. /inrht 0 def
  1219. /inflag 0 def
  1220. /outflag 0 def
  1221. /xadrht 0 def
  1222. /xadlft 0 def
  1223. /yadtop 0 def
  1224. /yadbot 0 def
  1225.  
  1226. % This saves the top right corner of the bounding box as a side effect
  1227. % This is to allow the adjustment of text placed with Mouter so that
  1228. % it misses the Minner text.  It is assumed that the ang is 0
  1229. % in the same way it is assumed that the text of Mouter is 0 or 90
  1230. %
  1231. /Minner {     % [(str)] gx gy sx sy ang Minner [(str)] gx gy sx sy ang
  1232.     outflag     % do a bit of tidying up if necessary
  1233.     1
  1234.     eq
  1235.     {
  1236.     /outflag 0 def
  1237.     /intop 0 def
  1238.     /inrht 0 def
  1239.     } if        
  1240.     5 index        % [(str)] gx gy sx sy ang [(str)]
  1241.     gsave
  1242.     Mtmatrix setmatrix
  1243.     Mvboxa pop    % [(str)] gx gy sx sy ang xlow ylow xhigh yhigh
  1244.     grestore
  1245.     3 -1 roll    % [(str)] gx gy sx sy ang xlow xhigh yhigh ylow
  1246.     pop        % [(str)] gx gy sx sy ang xlow xhigh yhigh
  1247.     dup        % [(str)] gx gy sx sy ang xlow xhigh yhigh yhigh
  1248.     intop        % is intop smaller than yhigh ?
  1249.     gt
  1250.     {
  1251.     /intop        % update if it is 
  1252.     exch def
  1253.     }
  1254.     { pop }        % pop if it is not
  1255.     ifelse        % [(str)] gx gy sx sy ang xlow xhigh
  1256.     dup        % [(str)] gx gy sx sy ang xlow xhigh xhigh    
  1257.     inrht        % is inrht smaller than xhigh
  1258.     gt
  1259.     {
  1260.     /inrht        % update if it is
  1261.     exch def
  1262.     }
  1263.     { pop }        % pop if it is no
  1264.     ifelse        % [(str)] gx gy sx sy ang xlow
  1265.     pop        % [(str)] gx gy sx sy ang
  1266.     /inflag        % set the inflag
  1267.     1 def
  1268. } bind def
  1269.  
  1270. % This takes two number off the stack and uses them as a vector in graphics
  1271. % coordinates which points in the direction in which the Mouter text is to move
  1272. % it calculates the bouding box adjustments yadtop yadbot xadrht and xadlft
  1273. % these are in Mboxout to adjust the bounding box to compensate.
  1274. /Mouter {        % vecx vecy Mouter ..
  1275.     /xadrht 0 def    % reset everything
  1276.     /xadlft 0 def
  1277.     /yadtop 0 def
  1278.     /yadbot 0 def
  1279.     inflag        % was there an inflag ?
  1280.     1 eq
  1281.     {
  1282.     dup        % vecx vecy vecy
  1283.     0 lt
  1284.     {
  1285.     dup        % vecx vecy vecy
  1286.     intop        % vecx vecy vecy intop
  1287.     mul
  1288.     neg        % vecx vecy -vecy*intop
  1289.     /yadtop     % make into yadtop
  1290.     exch def    % vecx vecy
  1291.     } if
  1292.     dup        % vecx vecy vecy
  1293.     0 gt
  1294.     {
  1295.     dup        % vecx vecy vecy
  1296.     intop        % vecx vecy vecy intop
  1297.     mul        % vecx vecy vecy*intop    
  1298.     /yadbot        % make into yadbot
  1299.     exch def    % vecx vecy
  1300.     }
  1301.     if
  1302.     pop        % vecx
  1303.     dup        % vecx vecx
  1304.     0 lt
  1305.     {
  1306.     dup        % vecx vecx
  1307.     inrht        % vecx vecx inrht
  1308.     mul
  1309.     neg        % vecx -vecx*inrht
  1310.     /xadrht        % make into xadrht
  1311.     exch def    % vecx
  1312.     } if
  1313.     dup        % vecx vecx
  1314.     0 gt
  1315.     {
  1316.     dup        % vecx vecx
  1317.     inrht        % vecx vecx inrht
  1318.     mul        % vecx vecx*inrht
  1319.     /xadlft        % make into xadlft
  1320.     exch def
  1321.     } if
  1322.     pop        %
  1323.     /outflag 1 def    % set outflag
  1324.     }
  1325.     { pop pop}    %
  1326.     ifelse
  1327.     /inflag 0 def
  1328.     /inrht 0 def
  1329.     /intop 0 def
  1330. } bind def    
  1331.  
  1332. %
  1333. % This adjusts the bounding box to account for adjacent text
  1334. % This allows the two text strings to avoid each other 
  1335. % current matrix is the text matrix
  1336. /Mboxout {    % tlx tly thx thy Mboxout new_tlx new_tly new_thx new_thy
  1337.     outflag        % do nothing unless Minner was found 
  1338.     1
  1339.     eq
  1340.     {
  1341.     4 -1
  1342.     roll        % tly thx thy tlx 
  1343.     xadlft
  1344.     leadjust
  1345.     add        % tly thx thy tlx xadlft+lead
  1346.     sub        % tly thx thy tlx_new
  1347.     4 1 roll    % tlx_new tly thx thy
  1348.     3 -1
  1349.     roll        % tlx_new thx thy tly
  1350.     yadbot        % tlx_new thx thy tly yadbot
  1351.     leadjust    % tlx_new thx thy tly yadbot lead
  1352.     add        % tlx_new thx thy tly yadbot+lead
  1353.     sub        % tlx_new thx thy tly_new
  1354.     3 1
  1355.     roll        % tlx_new tly_new thx thy
  1356.     exch        % tlx_new tly_new thy thx
  1357.     xadrht        % tlx_new tly_new thy thx xadrht
  1358.     leadjust    % tlx_new tly_new thy thx xadrht lead
  1359.     add        % tlx_new tly_new thy thx xadrht+lead
  1360.     add        % tlx_new tly_new thy thx_new
  1361.     exch        % tlx_new tly_new thx_new thy
  1362.     yadtop        % tlx_new tly_new thx_new thy yadtop
  1363.     leadjust    % tlx_new tly_new thx_new thy yadtop lead
  1364.     add        % tlx_new tly_new thx_new thy yadtop+lead
  1365.     add        % tlx_new tly_new thx_new thy_new 
  1366.     /outflag 0 def  % reset everything to 0
  1367.     /xadlft 0 def
  1368.     /yadbot 0 def
  1369.     /xadrht 0 def
  1370.     /yadtop 0 def
  1371.     } if
  1372. } bind def
  1373.  
  1374.  
  1375. /leadjust {
  1376.     (m) stringwidth pop
  1377.     .5 mul
  1378. } bind def
  1379.  
  1380.  
  1381. % The offsets sx and sy refer to the graphics coordinate system 
  1382. % thus they must be altered if a rotation has taken place.
  1383. % We must also change the bounding box computations for Minner
  1384. %
  1385. /Mrotcheck {        % sx sy ang Mrotcheck new_sx new_sy ang
  1386.     dup
  1387.     90
  1388.     eq
  1389.     {
  1390. %
  1391. % Mouter only applies to strings which are either at 0 or 90
  1392. % sort out the box adjust factors
  1393. %
  1394. %    xadrht -> yadbot
  1395. %    xadlft -> yadtop
  1396. %    yadtop -> xadrht
  1397. %    yadbot -> xadlft
  1398.     yadbot
  1399.     /yadbot
  1400.     xadrht
  1401.     def    
  1402.     /xadrht
  1403.     yadtop
  1404.     def
  1405.     /yadtop
  1406.     xadlft
  1407.     def
  1408.     /xadlft
  1409.     exch
  1410.     def
  1411.     }
  1412.     if
  1413.     dup        % sx sy ang ang
  1414.     cos         % sx sy ang Cos 
  1415.     1 index        % sx sy ang Cos    ang
  1416.     sin        % sx sy ang Cos Sin
  1417.     Checkaux    % new_sx sx sy ang 
  1418.     dup        % new_sx sx sy ang ang
  1419.     cos        % new_sx sx sy ang Cos
  1420.     1 index        % new_sx sx sy ang Cos ang
  1421.     sin neg        % new_sx sx sy ang Cos -Sin
  1422.     exch        % new_sx sx sy ang -Sin Cos
  1423.     Checkaux    % new_sx new_sy sx sy ang
  1424.     3 1 roll    % new_sx new_sy ang sx sy
  1425.     pop pop     % new_sx new_sy ang
  1426. } bind def
  1427.  
  1428. %
  1429. % Checkaux is an auxilliary function for Mrotcheck it multiplies a 
  1430. % row vector by a column vector
  1431. % 
  1432. /Checkaux {        % r1 r2 dumy c1 c2 Checkaux r1 r2 dumy r1*c1+r2*c2
  1433.     4 index        % r1 r2 dumy c1 c2 r1     
  1434.     exch        % r1 r2 dumy c1 r1 c2
  1435.     4 index        % r1 r2 dumy c1 r1 c2 r2
  1436.     mul        % r1 r2 dumy c1 r1 c2*r2
  1437.     3 1 roll    % r1 r2 dumy c2*r2 c1 r1
  1438.     mul add        % r1 r2 dumy c2*r2+c1*r1
  1439.     4 1 roll    % c2*r2+c1*r1 r1 r2 dumy
  1440. } bind def
  1441.  
  1442. %
  1443. % Mboxrot converts the bounding box back from the rotated coordinate
  1444. % system to the Mgmatrix system to compensate for a rotation
  1445. % It has the opposite functionality of Mrotcheck
  1446. % This is not the most neatest or most efficient implementation but it works
  1447. %
  1448. /Mboxrot {        % tlx thx tly thy Mboxrot new_tlx new_thx new_tly new_thy
  1449.     Mrot
  1450.     90 eq
  1451.     {
  1452. % old         tlx  thx  tly  thy
  1453. % new        -thy -tly  tlx  thx
  1454. %
  1455.     brotaux     % tlx thx -thy -tly
  1456.     4 2
  1457.     roll        % -thy -tly tlx thx
  1458.     }
  1459.     if
  1460.     Mrot
  1461.     180 eq
  1462.     {
  1463. % old         tlx  thx  tly  thy
  1464. % new        -thx -tlx -thx -tly
  1465. %
  1466.     4 2
  1467.         roll        % tly thy tlx thx
  1468.     brotaux        % tly thy -thx -tlx
  1469.     4 2
  1470.     roll        % -thx -tlx tlx thy
  1471.     brotaux        % -thx -tlx -thy -tly    
  1472.     }    
  1473.     if
  1474.     Mrot
  1475.     270 eq
  1476.     {
  1477. % old         tlx  thx  tly  thy
  1478. % new         tly  thy -thx -tlx
  1479. %
  1480.     4 2
  1481.     roll        % tly thy tlx thx
  1482.     brotaux        % tly thy -thx -tlx
  1483.     }
  1484.     if
  1485. } bind def
  1486.  
  1487. %
  1488. % auxilliary function negate and reverse
  1489. /brotaux {        % x y boxrotaux -y -x
  1490.     neg
  1491.     exch
  1492.     neg
  1493. } bind def
  1494.  
  1495. %
  1496. % Mabsproc takes a measurement in the default user units and converts
  1497. % it to the present units.   This allows absolute thickness and dashing
  1498. % to work.  It works by using a {0, x} vector and using the RMS of the result.
  1499. /Mabsproc { % abs thing Mabsproc
  1500.     0
  1501.         matrix defaultmatrix
  1502.         dtransform idtransform
  1503.     dup mul exch
  1504.     dup mul
  1505.     add sqrt
  1506. } bind def
  1507.  
  1508. %
  1509. % Mabswid allows the linewidth to be specified in absolute coordinates
  1510. % It does this by recording the graphics transformation matrix at the
  1511. % begining of the plot.
  1512. % This will break if the scaling in the x and y directions is
  1513. % different.  This is the case if Mnodistort is false
  1514. %
  1515. /Mabswid {    %abswid    Mabswid    
  1516.         Mabsproc
  1517.     setlinewidth    
  1518. } bind def
  1519.  
  1520. % Mabsdash allows the dashing pattern to be specified in absolute coordinates
  1521. % It does this by recording the graphics transformation matrix at the
  1522. % begining of the plot.
  1523. % This will break if the scaling in the x and y directions is
  1524. % different.  This is the case if Mnodistort is false
  1525. %
  1526. /Mabsdash {    %[d1 d2 d3 .. ] off Mabsdash    
  1527.         exch    % off [d1 d2 d3 ..]
  1528.         [               % off [d1 d2 d3 ..]
  1529.         exch            % off [ [d1 d2 d3 ..]
  1530.         {
  1531.         Mabsproc
  1532.         }
  1533.         forall
  1534.         ]               % off [ fact*d1 fact*d2 fact*d3 .. ]
  1535.         exch            % [ nd1 nd2 nd3 .. ] off
  1536.         setdash
  1537. } bind def
  1538.  
  1539. %MBeginOrig start coordinates in user coordinates
  1540. /MBeginOrig { Momatrix concat} bind def
  1541.  
  1542. %MEndOrig start coordinates in user coordinates
  1543. /MEndOrig { Mgmatrix setmatrix} bind def
  1544.  
  1545. %
  1546. % If colorimage does not exist then it is redifined in terms of
  1547. % image.  The image may not look very much like the original
  1548. % color ie there is no simple NTSC like conversion.
  1549. %
  1550. /colorimage where
  1551. { pop }
  1552. {
  1553. /colorimage {    %str w h b/c mat proc bool ncol
  1554. 3 1 roll            %str w h b/c mat ncol proc bool
  1555.  pop pop            %str w h b/c mat ncol
  1556.  5 -1 roll            % str h b/c mat ncol w
  1557.  mul                % str h b/c mat new_w
  1558.  4 1 roll            % str new_w h b/c mat
  1559. {%1 index str w h b/c proc bool ncol
  1560. %readhexstring
  1561. %pop pop
  1562. %currentfile
  1563. %1 index
  1564. %readhexstring
  1565. %pop pop
  1566. currentfile
  1567. 1 index
  1568. readhexstring
  1569. pop }
  1570. image
  1571. } bind def
  1572. } ifelse
  1573.  
  1574. /sampledsound where
  1575. { pop}
  1576. { /sampledsound { % str rate nsamp bs proc bool nchan
  1577. exch
  1578. pop            % str rate nsamp bs proc nchan
  1579. exch        % str rate nsamp bs nchan proc
  1580. 5 1 roll        % str proc rate nsamp bs nchan
  1581. mul
  1582. 4 idiv        % str proc rate nsamp bs*nchan/4
  1583. mul             % str proc rate nsamp*bs*nchan/4
  1584. 2 idiv        % str proc rate nbytes
  1585. exch pop        % str proc nbytes
  1586. exch        % str nbytes proc
  1587. /Mtempproc exch def
  1588. { Mtempproc pop}
  1589. repeat
  1590. } bind def
  1591. } ifelse
  1592.  
  1593. %
  1594. % now simple conversion of cmykcolor to rgbcolor
  1595. % subtract k and then take complements
  1596. /setcmykcolor where
  1597. { pop}
  1598. { /setcmykcolor {     % c m y k
  1599.     4 1
  1600.     roll            % k c m y
  1601.     [            % k c m y [
  1602.     4 1 
  1603.     roll            % k [  c m y
  1604.     ]             % k [ c m y ]
  1605.     {
  1606.     1 index        % k elem k
  1607.     sub            % k elem-k
  1608.     1
  1609.     sub neg        % k 1-(elem-k)
  1610.     dup
  1611.     0
  1612.     lt
  1613.     {
  1614.     pop
  1615.     0
  1616.     }
  1617.     if
  1618.     dup
  1619.     1
  1620.     gt
  1621.     {
  1622.     pop
  1623.     1
  1624.     }
  1625.     if
  1626.     exch        % 1-(elem-k) k
  1627.     } forall    % r g b k
  1628.     pop
  1629.     setrgbcolor
  1630. } bind def
  1631. } ifelse
  1632.  
  1633. /Ma /Mabswid load def
  1634. /a /arc load def
  1635. /c /curveto load def
  1636. /C /curveto load def
  1637. /d /setdash load def
  1638. /f /fill load def
  1639. /F /fill load def
  1640. /g /setgray load def
  1641. /gr /grestore load def
  1642. /gs /gsave load def
  1643. /k /stroke load def
  1644. /l /lineto load def
  1645. /L /lineto load def
  1646. /lw /setlinewidth load def
  1647. /m /moveto load def
  1648. /n /newpath load def
  1649. /p /gsave load def
  1650. /P /grestore load def
  1651. /r /setrgbcolor load def
  1652. /s /stroke load def
  1653. /w /setlinewidth load def
  1654. /beginmath /MBeginOrig load def
  1655. /endmath /MEndOrig load def
  1656.  
  1657. end
  1658.